COMMENT ⊗   VALID 00010 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	TITLE REVEAL - IMAGE ANALYSIS - BGB - MAY 1973.
C00007 00003	FETCH NEXT VISIBLE EDGE FROM A GIVEN EDGE ABOUT A GIVEN VERTEX.
C00010 00004	SUBR(MKPIMG)	MAKE PERCIEVED IMAGES FROM CRE IMAGES.
C00012 00005	
C00014 00006	SUBR(MKSIMG,CAMR)	MAKE SYNTHETIC IMAGE FROM OCCULT RESULTS.
C00016 00007	
C00018 00008	
C00020 00009	SUBR(MKCONE,BODY,Z1,Z2)
C00022 00010	SUBR(SETZPP,FACE,ZDEPTH,CAMERA)
C00024 ENDMK
C⊗;
TITLE REVEAL - IMAGE ANALYSIS - BGB - MAY 1973.

;DEFINE CRE LINK NAMES.

	%←←1B18
	DEFINE LEFT $(NAM,WRD){
	DEFINE NAM(A,Q)<CAR A,%+WRD(Q)>
	DEFINE NAM$.(A,Q)<DIP A,%+WRD(Q)>}

	DEFINE RIGHT $(NAM,WRD){
	DEFINE NAM(A,Q)<CDR A,%+WRD(Q)>
	DEFINE NAM$.(A,Q)<DAP A,%+WRD(Q)>}

	LEFT(%CW, 0)↔RIGHT(%CCW,0)	;RING LINKS.

	LEFT(%DAD,1)↔RIGHT(%SON,1)	;TREE OF RINGS.

	LEFT(%TYP,2)↔RIGHT(%ALT,2)

	LEFT(%ROW,3)↔RIGHT(%COL,3)	;IMAGE LOCUS.
	LEFT(%ENDO,3)↔RIGHT(%EXO,3)	;NESTED POLYGON TREE.

	LEFT(%ARC,4)

	↓ZDEPTH←←5
	LEFT(%NGON,5)↔RIGHT(%PGON,5)	;NESTED POLYGON TREE.

	LEFT(%NTIM,6)↔RIGHT(%PTIM,6)	;TIME LINE LINKS.

;-----------------------------------------------------------------
	DEFINE TJOINT(Q,V)<CAR Q,2(V)>
	EXTERN ECW,ECCW
;FETCH NEXT VISIBLE EDGE FROM A GIVEN EDGE ABOUT A GIVEN VERTEX.

COMMENT ⊗
	The Next Visible Edge  Conjecture - the next visible  edge CW
(or  CCW)  about  a  vertex  in  3D  (from  the  external side  of  a
polyhedron) must  be the next  visible edge  CW (or  CCW) about  that
vertex in any 2D image in which the retex is visible.
⊗

SUBR(QCW,EDGE,VERTEX)
COMMENT ⊗------------------------------------------------------------
⊗↔	U←←16  ↔  V←←15  ↔  E←←14

	LAC V,VERTEX↔LAC 1,EDGE
	TESTZ V,JUTBIT↔GO L1
	TESTZ V,JOTBIT↔GO L2

L0:	CALL(ECW,1,V)↔TEST 1,VISIBLE↔GO L0↔POP2J	;¬TJ.

L1:	PVT U,1↔TJOINT V,V↔PED 1,V			;JUT.
	CAME U,VERTEX↔POP2J
	CALL(ECCW,1,V)↔POP2J

L2:	NVT U,1↔CAME U,V↔GO L3				;JOT.
	CALL(ECCW,1,V)↔POP2J
L3:	TJOINT 1,V↔PED 1,1↔POP2J

ENDR QCW;8/4/73(BGB)-------------------------------------------------

SUBR(QCCW,EDGE,VERTEX)
COMMENT ⊗------------------------------------------------------------
⊗↔	U←←16  ↔  V←←15  ↔  E←←14
	LAC V,VERTEX↔LAC 1,EDGE
	TESTZ V,JUTBIT↔GO L1
	TESTZ V,JOTBIT↔GO L2

L0:	CALL(ECCW,1,V)↔TEST 1,VISIBLE↔GO L0↔POP2J	;¬TJ.

L1:	NVT U,1↔TJOINT V,V↔PED 1,V			;JUT.
	CAME U,VERTEX↔POP2J
	CALL(ECCW,1,V)↔POP2J

L2:	PVT U,1↔CAME U,V↔GO L3				;JOT.
	CALL(ECCW,1,V)↔POP2J
L3:	TJOINT 1,V↔PED 1,1↔POP2J

ENDR QCCW;8/4/73(BGB)------------------------------------------------
SUBR(MKPIMG)	;MAKE PERCIEVED IMAGES FROM CRE IMAGES.
COMMENT ⊗------------------------------------------------------------
⊗↔	EXTERN MKNODE,MKB,MKF,MKV,MKEV,MKFE,UNIVERSE
	ACCUMULATORS{A,B,C,D,E}

	SKIPN A,%+1↔POP0J
	DAC A,%IMG↔DAC A,%IMG0		;FIRST CRE IMAGE OF FILM.
	
;GET CONTEXT OF THESE IMAGES.
	LAC 1,UNIVERSE
	NWRLD 1,1↔DAC 1,WORLD	;"NOW" WORLD.
	NCAMR 1,1↔DAC 1,CAMERA	;"NOW" CAMERA.

;MAKE A GEOMED IMAGE.
L4:  	SETQ(IMG,{MKNODE,[PBIT+$IMAGE]})
	CW. 1,1↔CCW. 1,1		;EMPTY BODY RING.
	LAC WORLD↔PWRLD. 0,1		;WORLD OF THIS IMAGE.
	LAC C,CAMERA↔NCAMR. C,1		;CAMERA OF THIS IMAGE.

;PLACE THE IMAGE INTO THE CAMERA'S PERCEIVED IMAGE RING.
	PIMAG A,C↔JUMPN A,L4A		;JUMP WHEN ¬NEW RING.
	PTIME. 1,1↔NTIME. 1,1↔GO L5B
L4A:	PTIME B,A
	PTIME. 1,A↔NTIME. A,1
	PTIME. B,1↔NTIME. 1,B
L5B:	PIMAG. 1,C

	LAC A,%IMG↔%SON A,A
	DAC A,%LEV↔DAC A,%LEV0		;FIRST LEVEL OF IMAGE.

L3:	LAC A,%LEV↔%SON A,A
	DAC A,%PGN↔DAC A,%PGN0		;FIRST POLYGON OF LEVEL.

L2:	LAC A,%PGN↔%SON A,A
	DAC A,%V↔DAC A,%V0		;FIRST VERTEX OF POLYGON.

	SETQ(BDY,{MKB,IMG})		;ONE BODY PER POLYGON.
	SETQ(FACE,{MKF,BDY})
	SETQ(V0,{MKV,BDY})↔DAC 1,V

;COPY THE CRE-VECTORS INTO GEOMED EDGES & VERTICES.
L1:	LAC 2,%V
	%ROW 0,2↔FLO↔FSB[108.0]
	DACN YPP(1)↔FMPR[0.04]↔DACN YWC(1)
	%COL 0,2↔FLO↔FSB[144.0]
	DAC  XPP(1)↔FMPR[0.04]↔DAC XWC(1)
	SLACI(<131072.0>)↔DACN ZPP(1)		;ZDEPTH PERSPECTIVE 2↑17.

	%CCW 2,2↔DAC 2,%V			;NEXT VECTOR.
	CAME 2,%V0↔GO[
	SETQ(V,{MKEV,FACE,V})↔PED E,1
	MARK E,POTENT↔GO L1]			;NEXT EDGE.
	CALL(MKFE,V0,FACE,V)↔MARK 1,POTENT	;LAST EDGE.
	
;CLOSE LOOPS.
	LAC 1,%PGN↔%CCW 1,1↔DAC 1,%PGN		;NEXT POLYGON.
	CAME 1,%PGN0↔GO L2
	LAC 1,%LEV↔%CCW 1,1↔DAC 1,%LEV		;NEXT LEVEL.
	CAME 1,%LEV0↔GO L3
	LAC 1,%IMG↔%CCW 1,1↔DAC 1,%IMG		;NEXT IMAGE.
	CAME 1,%IMG0↔GO L4
	LAC 1,IMG↔POP0J
DECLARE{CAMERA,WORLD}
DECLARE{BDY,FACE,V,V0,%V,%V0,%PGN,%PGN0,%LEV,%LEV0,IMG,%IMG,%IMG0}
ENDR MKPIMG;3/14/73(BGB)------------------------------------------
SUBR(MKSIMG,CAMR)	;MAKE SYNTHETIC IMAGE FROM OCCULT RESULTS.
COMMENT ⊗------------------------------------------------------------
⊗↔	EXTERN MKNODE,MKB,MKF,MKV,MKEV,MKFE,UNIVERSE
	ACCUMULATORS{A,B,C,D,E,F,Q,V,U}

;GET CONTEXT OF THIS IMAGE.

	LAC 1,UNIVERSE
	NWRLD 1,1↔DAC 1,WORLD	;"NOW" WORLD.
	NCAMR 1,1↔DAC 1,CAMERA	;"NOW" CAMERA.

;MAKE A GEOMED IMAGE.

  	SETQ(IMG,{MKNODE,[PBIT+$IMAGE]})
	CW. 1,1↔CCW. 1,1		;EMPTY BODY RING.
	LAC WORLD↔PWRLD. 0,1		;WORLD OF THIS IMAGE.
	LAC C,CAMERA↔NCAMR. C,1		;CAMERA OF THIS IMAGE.

;PLACE THE IMAGE INTO THE CAMERA'S PERCEIVED IMAGE RING.
	SIMAG A,C↔JUMPN A,L1		;JUMP WHEN ¬NEW RING.
	PTIME. 1,1↔NTIME. 1,1↔GO L2
L1:	PTIME B,A
	PTIME. 1,A↔NTIME. A,1
	PTIME. B,1↔NTIME. 1,B
L2:	SIMAG. 1,C

	SETQ(BDY,{MKB,IMG})		;ONE BODY PER IMAGE.
	SETQ(BGND,{MKF,BDY})		;BACK GROUND FACE.
	LAC E,WORLD↔PED E,E
	SKIPA


;COPY ALL THE VISIBLE EDGES.
L3:	ALT2 E,E↔JUMPE E,L6
	SETQ(Q,{MKE↑,BDY})
	ALT. E,Q↔ALT. Q,E
	CAR(E)↔ANDI(DARKEN+NSHARP+FOLDED+VISIBLE+EBIT)↔DIP(Q)

;COPY THE FACES OF EACH EDGE.
	NFACE F,E↔TESTZ E,FOLDED↔UFACE F,E	;FACE OR UNDER FACE.
	JUMPE F,.+2
	TEST F,POTENT↔GO[LAC U,BGND↔GO L3N]	;BACKGROUND.
	TESTZ F,TBIT1↔GO[ALT U,F↔GO L3N]
	MARK F,TBIT1
	SETQ(U,{MKF,BDY})
	LAC 1,1(U)↔SLACI AA(F)↔LAPI AA(U)↔BLT 8(U)↔DAC 1,1(U)
	ALT. F,U↔ALT. U,F↔PED. Q,U
L3N:	NFACE. U,Q

	PFACE F,E
	TEST F,POTENT↔GO[LAC U,BGND↔GO L3P]	;BACKGROUND.
	TESTZ F,TBIT1↔GO[ALT U,F↔GO L3P]
	MARK F,TBIT1
	SETQ(U,{MKF,BDY})
	LAC 1,1(U)↔SLACI AA(F)↔LAPI AA(U)↔BLT 8(U)↔DAC 1,1(U)
	ALT. F,U↔ALT. U,F↔PED. Q,U
L3P:	PFACE. U,Q

;COPY THE VERTICES OF EACH EDGE.
	NVT V,E↔TESTZ V,JOTBIT↔TJOINT V,V
	TESTZ V,TBIT1↔GO[ALT U,V↔GO L4N]
	MARK V,TBIT1
	SETQ(U,{MKV↑,BDY})
	ALT. V,U↔ALT. U,V↔PED. Q,U
	LAC XPP(V)↔DAC XPP(U)		;PP LOCUS.
	LAC YPP(V)↔DAC YPP(U)
	LAC XWC(V)↔DAC XWC(U)		;WC LOCUS.
	LAC YWC(V)↔DAC YWC(U)
	LAC ZWC(V)↔DAC ZWC(U)
L4N:	NVT. U,Q

	PVT V,E↔TESTZ V,JOTBIT↔TJOINT V,V
	TESTZ V,TBIT1↔GO[ALT U,V↔GO L4P]
	MARK V,TBIT1
	SETQ(U,{MKV↑,BDY})
	ALT. V,U↔ALT. U,V↔PED. Q,U
	LAC XPP(V)↔DAC XPP(U)
	LAC YPP(V)↔DAC YPP(U)
	LAC XWC(V)↔DAC XWC(U)		;WC LOCUS.
	LAC YWC(V)↔DAC YWC(U)
	LAC ZWC(V)↔DAC ZWC(U)
L4P:	PVT. U,Q
	GO L3

;FIX UP THE WING LINKS.
L6:	LAC E,WORLD↔PED E,E↔SKIPA
L7:	ALT2 E,E↔JUMPE E,POP1J.↔ALT Q,E

	PVT V,E
	CALL(QCCW,E,V)↔ALT 1,1↔PCW.  1,Q
	CALL(QCW,E,V)↔ ALT 1,1↔NCCW. 1,Q

	NVT V,E
	CALL(QCCW,E,V)↔ALT 1,1↔NCW.  1,Q
	CALL(QCW,E,V)↔ ALT 1,1↔PCCW. 1,Q
	GO L7

DECLARE{CAMERA,WORLD,BDY,IMG,BGND}
ENDR MKSIMG;7/13/73(BGB)------------------------------------------
SUBR(MKCONE,BODY,Z1,Z2)
COMMENT ⊗------------------------------------------------------------
⊗
;CHECK BODY ARGUMENT.
	LAC 1,BODY↔TEST 1,BBIT↔POP3J
	SETQ(BNEW,{MKCOPY↑,BODY})	;COPY LAMINA INTO NOW WORLD.
	PFACE 1,1↔DAC 1,FACE		;FIRST FACE.

;GET NOW CAMERA.
	LAC 1,UNIVERSE↑↔NWRLD 1,1		;NOW WORLD.
	NCAMR 1,1↔DAC 1,CAMERA		;NOW CAMERA.

;CONVERT Z ARGUMENT FROM ZDEPTH ≡ ABS(ZCC) INTO ZPP.
	LAC 1,-1(1)↔LAC 2,1	;SCALEZ.
	FDVR 1,Z1↔FDVR 2,Z2
	DACM 1,Z1↔DACM 2,Z2

	CALL(SETZPP,FACE,Z1,CAMERA)
	CALL(SWEEP↑,FACE,[0])		;SWEEP SILHOUETTE CONE.
	CALL(SETZPP,FACE,Z2,CAMERA)
	LAC 1,BNEW
	POP3J
DECLARE{CAMERA,BNEW,FACE}
ENDR MKCONE;9/3/73(BGB)----------------------------------------------

SUBR(SETZPP,FACE,ZDEPTH,CAMERA)
COMMENT ⊗------------------------------------------------------------
  Clock around all the vertices of a face setting their ZPP.
⊗
	LAC 1,FACE↔PED 1,1			;1ST EDGE OF FACE.
	DAC 1,EDGE0↔DAC 1,EDGE
L1:	SETQ(VERTEX,{VCCW↑,EDGE,FACE})
	LAC ZDEPTH↔DAC ZPP(1)			;ZPP OF VERTEX.
	CALL(UNPROJECT↑,VERTEX,CAMERA)		;UNPROJECT THE VERTEX.
	SETQ(EDGE,{ECCW↑,EDGE,FACE})		;GET NEXT EDGE.
	CAME 1,EDGE0↔GO L1			;TEST FOR 1ST EDGE.
	POP3J
DECLARE{EDGE,EDGE0,VERTEX}
ENDR SETZPP;9/3/73(BGB)----------------------------------------------

END
REVEAL.FAI - EOF.